(load "map-utility")

(defparameter *congestion-city-nodes* nil)
(defparameter *congestion-city-edges* nil)
(defparameter *visited-nodes* nil)
(defparameter *node-num* 30)
(defparameter *edge-num* 45)
(defparameter *worm-num* 3)
(defparameter *cop-odds* 15)
(defparameter *player-pos* nil)
(defparameter *back-track* nil)


(defun random-node ()
  "Generate random node number."
  (1+ (random *node-num*)))

(defun edge-pair (a b)
  "Create bidirection edge pair."
  (unless (eql a b)
    (list (cons a b) (cons b a))))

(defun make-edge-list ()
  "Create `*edge-num*' random edges."
  (apply #'append (loop repeat *edge-num*
                       collect (edge-pair (random-node) (random-node)))))

(defun direct-edges (node edge-list)
  "Find all edges in EDGE-LIST direct connected with NODE."
  (remove-if-not (lambda (edge)
                   (eql node (car edge)))
                 edge-list))

(defun get-connected (node edge-list)
  "Find all nodes connected with NODE."
  (let ((visited nil))
    (labels ((travels (edge)
               (if edge
                   (unless (member (cdr edge) visited)
                     (push (cdr edge) visited)
                     (mapc #'travels (direct-edges (cdr edge) edge-list))))))
      ;; duplicate code, bad smell...
      (push node visited)
      (travels (car (direct-edges node edge-list))))
    visited))

(defun get-connected-2 (node edge-list)
  "Find all nodes connected with NODE."
  (let ((visited nil))
    (labels ((travese (node)
               (unless (member node visited)
                 (push node visited)
                 (mapc (lambda (edge)
                         (travese (cdr edge)))
                       (direct-edges node edge-list)))))
      (travese node))
    visited))

(defun find-islands (nodes edge-list)
  "Find all islands in EDGE-LIST."
  (let ((islands nil))
    (labels ((find-island (nodes)
               (let* ((connected (get-connected (car nodes) edge-list))
                      (unconnected (set-difference nodes connected)))
                 (push connected islands)
                 (when unconnected
                   (find-island unconnected)))))
      (find-island nodes))
    islands))

(defun connect-with-bridges (islands)
  "Get bridges lists"
  (when (cdr islands)
    (append (edge-pair (caar islands) (caadr islands))
            (connect-with-bridges (cdr islands)))))


(defun connect-all-islands (nodes edge-list)
  (append (connect-with-bridges (find-islands nodes edge-list))
          edge-list))


(defun add-cops (edge-alist edge-with-cops)
  (mapcar (lambda (x)
            (let ((node1 (car x))
                  (node1-edges (cdr x)))
              (cons node1
                    (mapcar (lambda (edge)
                              (let ((node2 (car edge)))
                                (if (intersection (edge-pair node1 node2)
                                                  edge-with-cops
                                                  :test #'equal)
                                    (list node2 'cops)
                                    edge)))
                            node1-edges))))
          edge-alist))

(defun edge-to-alist (edge-list)
  "Convert edge list to edge alist."
  (mapcar (lambda (x)
            (cons x (remove-duplicates (mapcar (lambda (e)
                                                 (list (cdr e)))
                                               (direct-edges x edge-list))
                                       :test #'equal)))
          (remove-duplicates (mapcar #'car edge-list))))

(defun make-city-edges ()
  (let* ((nodes (loop for i from 1 to *node-num*
                     collect i))
         (edge-list (connect-all-islands nodes (make-edge-list)))
         (cops (remove-if-not (lambda (x)
                                (zerop (random *cop-odds*)))
                              edge-list)))
    (add-cops (edge-to-alist edge-list) cops)))

(defun neighbors (node edge-alist)
  "Return a list of NODE's neighbors."
  (mapcar #'car (cdr (assoc node edge-alist))))

(defun within-one (a b edge-alist)
  "Return true if A & B in one edge."
  (member a (neighbors b edge-alist)))

(defun within-two (a b edge-alist)
  "Return true if A & B's distance less than two."
  (or (within-one a b edge-alist)
      (some (lambda (x)
              (within-one a x edge-alist))
            (neighbors b edge-alist))))

(defun make-city-nodes (edge-alist)
  (let ((wumpus (random-node))
        (glow-worms (loop for i below *worm-num*
                         collect (random-node))))
    (loop for n from 1 to *node-num*
         collect (append (list n)
                         (cond ((eql n wumpus) '(wumpus))
                               ((within-two n wumpus edge-alist) '(blood!)))
                         (cond ((member n glow-worms)
                                '(glow-worm))
                               ((some (lambda (x)
                                        (within-one n x edge-alist))
                                      glow-worms)
                                '(lights!)))
                         (when (some #'cdr (cdr (assoc n edge-alist)))
                           '(sirens!))))))

(setf *congestion-city-edges* (make-city-edges))
(setf *congestion-city-nodes* (make-city-nodes *congestion-city-edges*))

(defun draw-city ()
  (ugraph->png "hunt" *congestion-city-nodes* *congestion-city-edges*))

(defun known-city-nodes ()
  (mapcar (lambda (node)
            (if (member node *visited-nodes*)
                (let ((n (assoc node *congestion-city-nodes*)))
                  (if (eql node *player-pos*)
                      (append n '(*))
                      n))
                (list node '?)))
  (remove-duplicates
   (append *visited-nodes*
           (mapcan (lambda (node)
                     (mapcar #'car
                             (cdr (assoc node *congestion-city-edges*))))
                   *visited-nodes*)))))

(defun known-city-edges ()
  (mapcar (lambda (node)
            (cons node
                  (mapcar (lambda (x)
                            (if (member (car x) *visited-nodes*)
                                x
                                (list (car x))))
                          (cdr (assoc node *congestion-city-edges*)))))
          *visited-nodes*))

(defun draw-known-city ()
  (ugraph->png "known-city" (known-city-nodes) (known-city-edges)))

(defun new-game ()
  (setf *congestion-city-edges* (make-city-edges))
  (setf *congestion-city-nodes* (make-city-nodes *congestion-city-edges*))
  (setf *player-pos* (find-empty-node))
  (setf *visited-nodes* (list *player-pos*))
  (setf *back-track* nil)
  (push *player-pos* *back-track*)
  (draw-city)
  (draw-known-city))

(defun find-empty-node ()
  (let ((x (random-node)))
    (if (cdr (assoc x *congestion-city-nodes*))
        (find-empty-node)
        x)))

(new-game)


(defun walk (pos)
  (handle-direction pos nil))

(defun charge (pos)
  (handle-direction pos t))

(defun handle-direction (pos charge)
  (let ((edge (assoc pos
                     (cdr (assoc *player-pos* *congestion-city-edges*)))))
    (if edge
        (handle-new-place edge pos charge)
        (princ "That location does not exist!"))))

(defun handle-new-place (edge pos charge)
  (let* ((node (assoc pos *congestion-city-nodes*))
         (has-worm (and (member 'glow-worm node)
                        (not (member pos *visited-nodes*)))))
    ;; (pushnew)
    (pushnew pos *visited-nodes*)
    (setf *player-pos* pos)
    (push *player-pos* *back-track*)
    (draw-known-city)
    (cond ((member 'cops edge)
           (princ "You ran into the cops. Game Over."))
          ((member 'wumpus node)
           (if charge
               (princ "You found the Wumpus!")
               (princ "You ran into the Wumpus!")))
          (charge
           (princ "You wasted your last bullet. Game Over."))
          (has-worm
           (let ((new-pos (random-node)))
             (princ "You ran into a Glow Worm Gang! You now at")
             (setf *back-track* nil)
             (princ new-pos)
             (handle-new-place nil new-pos nil))))))

(defun handle-old-place (bt)
  (setf *player-pos* (car bt))
  (setf *back-track* bt)
  (draw-known-city))

(defun back (pos)
  (if (member pos *back-track*)
      (labels ((back-track (pos bt)
                 (if (eql pos (car bt))
                     (handle-old-place bt)
                     (back-track pos (cdr bt)))))
        (back-track pos *back-track*))
      (princ "You cant back track to that positon.")))
